home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tmort.zip
/
TMORT.PRG
< prev
Wrap
Text File
|
1993-04-12
|
5KB
|
135 lines
program TMort; {The Mortgage Analyzer}
uses crt, dos;
const
TermString = 'months'; {Mod. #1}
NumPayPerYr = 12; {Mod. #2}
type
KeyListType = string[4];
var
Principal, Payment, FirstPayment, InterestRate : real;
Interest, Balance, IntFactor, Amortized : real;
TotalPayments, TotalInterest, TotalAmort : real;
TotalNumPay, Code, LineCount, PayNum, LinesToShow : integer;
CharFlag, Reply, Reply2 : char;
WantToSeeIt : boolean;
{$I GetKey.PSL}
{$I GetNumI.PSL}
{$I GetNumR.PSL}
{$I LoanPay.PSL}
procedure Header;
begin
clrscr;
writeln('Mortgage - Analysis of a loan repayment');
writeln;
writeln('Principal', '=':8, Principal:11:2);
writeln('Interest rate', '=':4, InterestRate:11:2);
writeln('Regular payment =', FirstPayment:11:2);
writeln('Term in ', TermString, '=':3, TotalNumPay:8);
writeln;
write('Remaining':16, '---Interest Paid---':22);
writeln('-Amount Amortized-':22);
writeln('Paymt.', 'Balance':9, 'This time':13,
'To date':10, 'This time':13, 'To date':9)
end;
BEGIN
clrscr;
writeln('Mortgage - Analysis of a loan repayment');
repeat
writeln;
writeln('Please enter the principal.');
GetNumR(Principal, CharFlag, Code)
until
(Principal > 0.0) and (Code = 0);
repeat
writeln;
writeln('Please enter the annual interest rate.');
GetNumR(InterestRate, CharFlag, Code)
until
(Code = 0) and (InterestRate > 0.0) and
(InterestRate < 100.0);
repeat
writeln;
write('Please enter the length of the loan in ');
writeln(TermString, '.');
GetNumI(TotalNumPay, CharFlag, Code)
until
(Code = 0) and (TotalNumPay > 0) and (TotalNumPay < 2000);
Payment := LoanPay(Principal, InterestRate,
TotalNumPay, NumPayPerYr);
writeln;
writeln('Regular payment is', Payment:11:2);
write('Do you want to override this (Y or N)? ');
GetKey('YyNn', Reply, Reply2);
writeln(Reply);
if (Reply = 'Y') or (Reply = 'y') then
begin
repeat
writeln;
writeln('Please enter the desired payment.');
GetNumR(Payment, CharFlag, Code)
until
(Code = 0) and (Payment > 0.0)
end;
Payment := int(Payment * 100.0 + 0.5) / 100.0;
FirstPayment := Payment;
Header;
Balance := int(Principal * 100.0 + 0.5) / 100.0;
IntFactor := InterestRate / NumPayPerYr;
TotalPayments := 0.0;
TotalInterest := 0.0;
TotalAmort := 0.0;
WantToSeeIt := true;
LinesToShow := 12; {Mod. #3}
LineCount := 0;
PayNum := 0;
repeat
inc(PayNum);
Interest := int(Balance * IntFactor + 0.5) / 100.0;
if PayNum = TotalNumPay then
Payment := Balance + Interest;
Amortized := Payment - Interest;
Balance := Balance - Amortized;
if Balance < 0.0 then
begin
Payment := Payment + Balance;
Amortized := Amortized + Balance;
Balance := 0.0
end;
TotalPayments := TotalPayments + Payment;
TotalInterest := TotalInterest + Interest;
TotalAmort := TotalAmort + Amortized;
if WantToSeeIt then
begin
write(PayNum:4, Balance:12:2, Interest:11:2);
write(TotalInterest:11:2, Amortized:11:2);
writeln(TotalAmort:11:2);
inc(LineCount);
if LineCount = LinesToShow then
begin
writeln;
write('Press T for Totals');
writeln(' or [Enter] for next screen.');
GetKey('Tt' + chr(13), Reply, Reply2);
if Reply in ['T', 't'] then
WantToSeeIt := false;
Header;
LineCount := 0
end
end
until
(PayNum = TotalNumPay) or (Balance = 0.0);
writeln;
writeln('Last payment =', Payment:11:2);
writeln('Total payments =', TotalPayments:11:2);
writeln('Total number of payments =', PayNum:5);
writeln('Ratio of total payments to principal =',
TotalPayments / Principal:8:4)
END.